home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacGofer 0.22d / MacGofer Sources / gofc.c < prev    next >
Encoding:
Text File  |  1994-01-07  |  10.3 KB  |  268 lines  |  [TEXT/MPS ]
  1. nner now includes my name.  Gofer is provided free of */
  2.     /* charge.  I ask however that you show your appreciation for the many */
  3.     /* hours of work involved by retaining my name in the banner.  Thanks! */
  4.  
  5.     printf("Gofer->C Version %s  Copyright (c) Mark P Jones 1992-1993\n\n",
  6.        VERSION);
  7.     fflush(stdout);
  8.     breakOn(TRUE);
  9. #if DYNAMIC_STORAGE
  10.     Dynamic_Storage_Init();
  11. #endif
  12.     initialise(argc, argv);          /* initialise compiler           */
  13.  
  14.     if (dumpScs) {            /* produce script of sc defns for  */
  15.     gofcFp = initOutput(".gsc");    /* debugging purposes           */
  16.     printf("[Writing supercombinators to \"%s\"]\n",outputFile);
  17.     loadCompile();
  18.     fprintf(gofcFp,"\n/* end of %s */\n",outputFile);
  19.     fclose(gofcFp);
  20.     }
  21.     else {                /* produce C code as output       */
  22.     extern Void outputCode Args((FILE *,Name));
  23.     Name mn;
  24.     loadCompile();
  25.     gofcFp = initOutput(".c");
  26.  
  27.     mn = findName(findText("main"));/* check for main symbol       */
  28.     if (isNull(mn)) {
  29.         ERROR(0) "Program must include definition for \"main\"::Dialogue"
  30.         EEND;
  31.     }
  32.  
  33.     if (name(mn).defn==CFUN ||    /* check that definition is ok       */
  34.         name(mn).defn==MFUN ||
  35.         name(mn).primDef ||
  36.         isNull(name(mn).type)) {
  37.         ERROR(0) "Invalid definition for \"main\""
  38.         EEND;
  39.     }
  40.  
  41.     if (!typeMatches(name(mn).type,typeDialogue)) {
  42.         ERROR(0) "Illegal typing for \"main\":" ETHEN
  43.         ERRTEXT  "\n*** inferred type  : "      ETHEN
  44.         ERRTYPE(name(mn).type);
  45.         ERRTEXT  "\n*** does not match : Dialogue\n"
  46.         EEND;
  47.     }
  48.  
  49.     printf("\nWriting C output file \"%s\":\n",outputFile);
  50.     outputCode(gofcFp,mn);
  51.     fclose(gofcFp);
  52.     }
  53.  
  54.     printf("[Leaving Gofer->C]\n");
  55.     everybody(EXIT);
  56.     exit(0);
  57.     MainDone
  58. }
  59.  
  60. static Void local loadCompile() {    /* load and compile source modules */
  61.     Module i;
  62.     Time   timeStamp;
  63.     Long   fileSize;
  64.  
  65.     for (i=0; i<namesUpto; ++i) {    /* load and compile source modules */
  66.     getFileInfo(scriptName[i], &timeStamp, &fileSize);
  67.     if (i>0)
  68.         startNewModule();
  69.         addScript(scriptName[i], fileSize);
  70.     numScripts++;
  71.     }
  72. }
  73.  
  74. /* --------------------------------------------------------------------------
  75.  * Determine name of output file:
  76.  * ------------------------------------------------------------------------*/
  77.  
  78. static Fp local initOutput(suff)    /* find name for output file, open */
  79. String suff; {                /* it and write header ...       */
  80.     Fp  fp = 0;
  81.     int i;
  82.  
  83.     if (!outputFile) {            /* user specified name has priority*/
  84.     String s,dot;
  85.  
  86.     if (projectLoaded && currProject)    /* use project name if poss*/
  87.         s = currProject;
  88.     else
  89.         s = scriptName[namesUpto-1];    /* o/w use last script name*/
  90.  
  91.     outputFile = malloc(strlen(s)+strlen(suff)+1);
  92.     if (!outputFile)
  93.         fatal("setOutputName");
  94.     strcpy(outputFile,s);
  95.  
  96. #if !RISCOS
  97.         for (s=outputFile, dot=0; *s; ++s)    /* do something sensible   */
  98.         if (*s=='.')            /* with file extensions       */
  99.         dot = s;
  100.  
  101.     if (dot && (strcmp(dot+1,"gp") == 0 || strcmp(dot+1,"prj") ==0 ||
  102.             strcmp(dot+1,"hs") == 0 || strcmp(dot+1,"lhs") ==0 ||
  103.             strcmp(dot+1,"gs") == 0 || strcmp(dot+1,"lgs") ==0 ||
  104.             strcmp(dot+1,"gof")== 0 || strcmp(dot+1,"has") ==0 ||
  105.             strcmp(dot+1,"lit")== 0 || strcmp(dot+1,"verb")==0 ||
  106.             strcmp(dot+1,"prelude")==0))
  107.         *dot = '\0';
  108.  
  109.     strcat(outputFile,suff);
  110. #else
  111.     /* What strange code!  It uses strlen three times, when once is enough.  KH */
  112.     strcat(outputFile,suff);
  113.     outputFile[strlen(outputFile)-strlen(suff)] = '_'; /* No dot */
  114. #endif
  115.     }
  116.  
  117.     if (!(fp=fopen(outputFile,"w"))) {        /* now try to open       */
  118.     ERROR(0) "Unable to open output file \"%s\" for writing",
  119.          outputFile
  120.     EEND;
  121.     }
  122.  
  123.     fprintf(fp,"/* %s\t\t\t\t%s *\n",outputFile,timeString());
  124.     fprintf(fp," * This program produced by gofc %s from:\n",VERSION);
  125.  
  126.     if (projectLoaded && currProject)
  127.         fprintf(fp," * Project file %s comprising:\n",currProject);
  128.  
  129.     for (i=0; i<namesUpto; i++)
  130.         fprintf(fp," *\t%s\n",scriptName[i]);
  131.     fprintf(fp," */\n\n");
  132.  
  133.     return fp;
  134. }
  135.  
  136. /* --------------------------------------------------------------------------
  137.  * Include our own version of output.c with ability to output sc defns
  138.  * (This is a big hack, but it would probably be worth doing a proper
  139.  * overhaul of the overall structure of Gofer before spending too much
  140.  * time here.)
  141.  * ------------------------------------------------------------------------*/
  142.  
  143. #define GOFC_OUTPUT
  144. #include "output.c"
  145.  
  146. /* --------------------------------------------------------------------------
  147.  * Initialisation, interpret command line args and read prelude:
  148.  * ------------------------------------------------------------------------*/
  149.  
  150. struct options toggle[] = {
  151.     {'d', "Show dictionary values in output exprs",&showDicts},
  152.     {'g', "Print no. cells recovered after gc",       &gcMessages},
  153.     {'c', "Test conformality for pattern bindings",&useConformality},
  154.     {'l', "Treat input files as literate scripts", &literateScripts},
  155.     {'e', "Warn about errors in literate scripts", &literateErrors},
  156.     {'i', "Apply fromInteger to integer literals", &coerceNumLiterals},
  157.     {'o', "Optimise use of (&&) and (||)",       &andorOptimise},
  158.     {'u', "Catch ambiguously typed top-level vars",&catchAmbigs},
  159.     {'a', "Use any evidence, not nec. best",       &anyEvidence},
  160.     {'E', "Fail silently if evidence not found",   &silentEvFail},
  161.     {'.', "Print dots to show progress",       &useDots},
  162.     {'1', "Overload singleton list notation",       &overSingleton},
  163.     {'D', "Output .gsc file for debugging",       &dumpScs},
  164.     {0,   0,                       0}
  165. };
  166.  
  167. /* I'm not sure whether all these are needed for the compiler! KH */
  168. struct options memopt[] = {        /* List of memory settings -- KH */
  169. #if DYNAMIC_STORAGE
  170.     {'a', "Number of Machine Addresses",       &num_addrs},
  171.     {'c', "Number of Classes",               &num_classes},
  172.     {'d', "Number of Dictionaries",           &num_dicts},
  173.     {'i', "Number of Instances",           &num_insts},
  174.     {'I', "Number of Indexes",               &num_indexes},
  175.     {'m', "Number of Modules",               &num_modules},
  176.     {'n', "Number of Identifiers (Names)",       &num_name},
  177.     {'o', "Number of Machine Offsets",           &num_offsets},
  178.     {'s', "Size of Machine Stack (words)",       &num_stack},
  179.     {'S', "Number of Selectors",           &num_selects},
  180.     {'t', "Number of Type Constructors",       &num_tycon},
  181.     {'T', "Number of Tuple Types",           &num_tuples},
  182.     {'v', "Number of Type Variables",           &num_tyvars},
  183.     {'x', "Size of Text Buffer for Identifiers",   &num_text},
  184.     {'y', "Number of Operators Allowed",       &num_syntax},
  185. #endif
  186.     {0,   0,                       0}
  187. };
  188.  
  189.  
  190. static Void local initialise(argc,argv)/* compiler initialisation       */
  191. Int    argc;
  192. String argv[]; {
  193.     Module i;
  194.     String proj = 0;
  195.  
  196.     scriptFile      = 0;
  197.     numScripts      = 0;
  198.     namesUpto      = 1;
  199.     scriptName[0] = strCopy(fromEnv("GOFER",STD_PRELUDE));
  200.  
  201.     for (i=1; i<argc; ++i)        /* process command line arguments  */
  202.     if (strcmp(argv[i],"+")==0 && i+1<argc)
  203.         if (proj) {
  204.         ERROR(0) "Multiple project filenames on command line"
  205.         EEND;
  206.         }
  207.         else
  208.         proj = argv[++i];
  209.     else
  210.         addScriptName(argv[i]);
  211.  
  212.     everybody(INSTALL);
  213.     if (proj) {
  214.     if (namesUpto>1)
  215.         fprintf(stderr,
  216.             "\nUsing project file, ignoring additional filenames\n");
  217.     loadProject(strCopy(proj));
  218.     }
  219. }
  220.  
  221. Void errHead(l)                /* print start of error message       */
  222. Int l; {
  223.     failed();                   /* failed to reach target ...       */
  224.     fprintf(errorStream,"ERROR");
  225.  
  226.     if (scriptFile) {
  227.     fprintf(errorStream," \"%s\"", scriptFile);
  228.     if (l) fprintf(errorStream," (line %d)",l);
  229.     }
  230.     fprintf(errorStream,": ");
  231.     fflush(errorStream);
  232. }
  233.  
  234. Void errFail() {               /* terminate error message       */
  235.     fprintf(errorStream,"\nAborting compilation\n");
  236.     fflush(errorStream);
  237.     exit(1);
  238. }
  239.  
  240. Void errAbort() {            /* altern. form of error handling  */
  241.     failed();                /* used when suitable error message*/
  242.     errFail();
  243. }
  244.  
  245. Void internal(msg)            /* handle internal error       */
  246. String msg; {
  247.     fatal(msg);                /* treat as fatal condition       */
  248. }
  249.  
  250. Void fatal(msg)                /* handle fatal error            */
  251. String msg; {
  252.     fflush(stdout);
  253.     printf("\nINTERNAL ERROR: %s\n",msg);
  254.     everybody(EXIT);
  255.     exit(1);
  256. }
  257.  
  258. sigHandler(breakHandler) {           /* respond to break interrupt       */
  259.     breakOn(TRUE);
  260.     printf("{Interrupted!}\n");
  261.     everybody(BREAK);
  262.     fflush(stdout);
  263.     errAbort();
  264.     sigResume;/*NOTREACHED*/
  265. }
  266.  
  267. /*-------------------------------------------------------------------------*/
  268.